Softdisk G-S 112

home *** CD-ROM | disk | FTP | other *** search

/ Softdisk G-S 112 / SGDS 112.2mg / SDGS.112 / D / EXPLORER.M (.txt) < prev next >

Wrap

Applesoft BASIC Source Code | 1989-09-06 | 8.7 KB | 380 lines | [FC] Applesoft BASIC Program (0x0801)

10 HIMEM: 36352 100 REM Logistic Difference Equation explorer 110 REM (C) Cregg Hardwick 1989 1000 REM 1030 DATA 2,0,6,0,18,0 1040 DATA 45,45,45,53,54,62 1050 DATA 63,63,63,36,36,0,6,0 1060 DATA 104,168,104,166,223,154,72,152,72,96,300 1080 REM Routine Main 1090 D$ = CHR$(4): PRINT D$;"Bload Explorer.X" 1110 ROT= 0:CLR = 782:BOX = 24576:BELL% = 1 1120 MOVPG = 2048:AUXIL = 2054 1122 CALL AUXIL 1125 GOSUB 1500 1130 GOSUB 4000 1150 DN% = 278:TP% = 159 1160 R = 1:RO = 1 1170 IN = 3/280:MG = 1 1180 GS = TP%:GF = 0 1185 CALL CLR 1186 GOSUB 5000:TG% = 1 1188 POKE 768,160 1189 POKE 773,0: IF TG% = 1 THEN POKE 773,255 1190 PRINT " <C>ompute new graph or "; 1191 POKE 773,0: PRINT " ": IF TG% = 2 THEN POKE 773,255 1192 PRINT " <L>oad a graph from disk. " 1193 POKE 773,0: PRINT " Arrows to select, RETURN to accept. " 1194 PRINT " ESC to quit. ? for Help." 1195 HELP$ = "7": GOSUB 5200 1196 IF CM% = 27 THEN GOSUB 9000: GOTO 1186 1198 IF C$ = "C" OR C$ = "c" THEN TG% = 1: GOTO 1188 1199 IF C$ = "L" OR C$ = "l" THEN TG% = 2: GOTO 1188 1200 IF CM% = 10 OR CM% = 21 OR CM% = 11 OR CM% = 8 THEN TG% = TG% +1 1202 IF TG% = 3 THEN TG% = 1 1204 IF CM% < >13 THEN GOTO 1188 1210 IF TG% = 2 THEN GOSUB 11000: GOTO 1280 1220 GOSUB 5000: POKE 768,160 1229 PT$ = "Enter settling time in generations:":VL% = 22 1230 GOSUB 1600:CS% = VL% 1249 PT$ = "Enter number of points to plot:":VL% = 23 1250 GOSUB 1600:DT% = VL% 1270 GOSUB 2430 1280 CR% = 1 1300 GOSUB 2950 1310 IF CM% = 27 THEN GOSUB 9000: GOTO 1300 1320 FY% = 1 1330 GOSUB 1750 1340 IF CM% = 27 THEN 1280 1390 R = RO +(FX% *IN) 1400 RO = R 1410 MG = MG *BS 1420 IN = IN *(1/BS) 1430 GS = GS *BS 1440 GF = (GF +(TP% -(FY% +HT%))) *BS 1450 GOTO 1186 1500 REM Routine Poke ShapeTable/Fix 1505 DEST = 3072 1510 POKE 232,DEST -( INT(DEST/256) *256): POKE 233, INT(DEST/256) 1520 READ BYTE% 1530 POKE DEST,BYTE% 1550 DEST = DEST +1 1560 READ BYTE% 1570 IF BYTE% < >300 THEN 1530 1580 FIX = DEST -10 1590 RETURN 1600 POKE 768,(8 *VL%) -8: PRINT PT$; 1645 VL$ = " ": POKE 772,2: PRINT " "; 1650 HELP$ = "1": GOSUB 5200 1652 IF CM% = 27 THEN GOSUB 9000 1655 IF LEN(VL$) <2 OR (CM% < >8 AND CM% < >127) THEN 1680 1660 VL$ = LEFT$(VL$, LEN(VL$) -1) 1670 POKE 770, PEEK(770) -1: POKE 769,0 1675 PRINT " ";: POKE 770, PEEK(770) -2 1680 IF CM% = 13 THEN 1720 1690 IF LEN(VL$) >4 OR CM% <48 OR CM% >57 THEN 1710 1700 VL$ = VL$ +C$: POKE 769,1: PRINT C$; 1710 GOTO 1650 1720 V = VAL(VL$): IF V >9000 THEN V = 9000 1730 IF V = 0 THEN V = 1 1740 VL% = V: POKE 772,1: POKE 770,1: RETURN 1750 REM Routine MovMenu 1760 GOSUB 5000 1800 PRINT "Use arrows to move box. '<' and '>'" 1810 PRINT "SPACE adjusts movement. size the box." 1820 PRINT "RETURN to blow up box." 1830 PRINT "ESC goes back one menu. ? for Help.";: POKE 768,32 1842 WD% = 49 1844 IF I% >WD% THEN FX% = I% -WD%: GOTO 1850 1846 FX% = 1 1850 GOSUB 2370 1860 HELP$ = "2": GOSUB 5200 1870 GOSUB 2370 1900 GOSUB 1970 1910 GOSUB 2090 1920 GOSUB 2200 1930 GOSUB 2300 1940 GOSUB 2370 1950 IF CM% < >27 AND CM% < >13 THEN 1860 1955 IF CM% = 27 THEN GOSUB 2370 1960 RETURN 1970 REM Routine SizeFrame 1990 IF C$ < >"<" AND C$ < >"," THEN 2020 2000 IF WD% >13 THEN WD% = WD% -7 2020 IF C$ < >">" AND C$ < >"." THEN 2060 2030 IF WD% <78 THEN WD% = WD% +7 2040 IF FX% +WD% >I% OR FY% +HT% >TP% THEN WD% = WD% -7 2060 BS = DN%/WD% 2070 HT% = TP%/BS 2080 RETURN 2090 REM Routine VertMov 2120 IF CM% < >11 THEN 2150 2130 IF FY% >CR% THEN FY% = FY% -CR%: GOTO 2150 2132 FY% = TP% -HT% -1 2150 IF CM% < >10 THEN 2180 2160 IF FY% <TP% -HT% -CR% THEN FY% = FY% +CR%: GOTO 2180 2170 FY% = 0 2180 RETURN 2200 REM Routine HorizMov 2220 IF CM% < >8 THEN 2250 2230 IF FX% >CR% THEN FX% = FX% -CR%: GOTO 2250 2240 FX% = I% -WD% -1 2250 IF CM% < >21 THEN 2280 2260 IF FX% <I% -WD% -CR% THEN FX% = FX% +CR%: GOTO 2280 2270 FX% = 0 2280 RETURN 2300 REM Routine CurSkip 2320 IF C$ < >" " THEN 2360 2330 CR% = CR% *4 2340 IF CR% >16 THEN CR% = 1 2360 RETURN 2370 REM Routine XDraw_Frame 2380 SZ% = (WD%/7): SCALE= SZ% 2400 XDRAW 1 AT FX%,FY% 2420 RETURN 2430 REM Routine DrawGraph 2510 I% = 0 2520 GOSUB 5000 2530 POKE 770,9: PRINT "Magnification :";MG 2540 PRINT : PRINT " Plotting... Press Esc to abort." 2550 HCOLOR= 0: HPLOT 0,0 TO 0,160 2560 HCOLOR= (MD% *4) -4 2571 HPLOT I%,TP% 2575 FOR L = 1 TO MD% 2580 I% = I% +1:R = R +IN 2585 HPLOT I%,TP% TO I%,0 2590 NEXT L 2600 IF MD% = 1 THEN HCOLOR= 3: GOTO 2610 2602 HCOLOR= 6 2610 HPLOT I%,TP% 2630 X = 0.1 2640 CALL AUXIL +6 2650 CALL AUXIL +9 2660 CM% = PEEK( -16384) 2670 IF CM% < >155 AND I% <DN% THEN 2560 2675 HCOLOR= (MD% *4) -4 2677 IF I% <DN% THEN CALL AUXIL +3 2680 POKE -16368,0 2690 IF I% > = DN% THEN I% = DN% -1 2692 IF I% <WD% THEN I% = WD% +1 2700 IF CM% < >155 AND BELL% THEN PRINT CHR$(7) CHR$(7) CHR$(7) 2710 RETURN 2946 REM Routine Chose Analysis or Blow up. 2950 GOSUB 5000:TG% = 1 2955 POKE 768,160 2956 POKE 773,0: IF TG% = 1 THEN POKE 773,255 2960 PRINT " Press <T> for Time-series analysis. "; 2966 POKE 773,0: PRINT " ": IF TG% = 2 THEN POKE 773,255 2970 PRINT " <B> Blows up a section of graph. " 2976 POKE 773,0: PRINT " Arrows to select, RETURN to accept." 2980 PRINT " ESC to quit. S to Save. ? for Help." 2990 HELP$ = "3": GOSUB 5200 3000 IF CM% = 27 THEN 3060 3030 IF C$ = "S" OR C$ = "s" THEN GOSUB 10000: GOTO 2950 3032 IF C$ = "B" OR C$ = "b" THEN TG% = 2: GOTO 2955 3033 IF C$ = "T" OR C$ = "t" THEN TG% = 1: GOTO 2955 3034 IF CM% = 10 OR CM% = 21 THEN TG% = TG% +1 3035 IF CM% = 11 OR CM% = 8 THEN TG% = TG% +1 3037 IF TG% = 3 THEN TG% = 1 3039 IF CM% < >13 THEN GOTO 2955 3040 IF TG% = 1 THEN GOSUB 3080 3050 IF CM% = 27 THEN 2950 3060 RETURN 3080 REM Routine TimeSeries 3110 T1% = FX%:T2% = I% 3120 WD% = 1 3130 IF I% >1 THEN FX% = I% -1: GOTO 3140 3140 FX% = 1: GOSUB 3430 3150 GOSUB 5000 3160 PRINT "Use arrows to move cursor line." 3170 PRINT "SPACE adjusts movement of cursor line." 3180 PRINT "RETURN to run time-series analysis." 3190 PRINT "ESC for previous menu. ? for Help."; 3210 HELP$ = "4": GOSUB 5200 3220 IF CM% = 27 THEN 3370 3230 GOSUB 3430 3260 GOSUB 2200 3270 GOSUB 2300 3280 GOSUB 3430 3290 IF CM% < >13 THEN 3210 3310 CALL MOVPG 3320 CALL CLR: POKE 768,160: GOSUB 3470 3340 I% = T2%: CALL MOVPG +3 3370 IF CM% < >27 THEN 3150 3380 GOSUB 3430 3390 CR% = 1:FX% = T1%:I% = T2% 3410 RETURN 3430 SCALE= 130 3440 XDRAW 2 AT FX%,15 3460 RETURN 3470 REM Routine Analysis 3490 AN = RO +(FX% *INC) 3500 X = 0.1:J = 150:JO = 150: HCOLOR= 3 3510 CALL CLR: POKE 768,160 3520 PRINT "Time-Series analysis at ";AN 3530 PRINT "SPACE or RETURN continues analysis." 3540 PRINT "ESC returns to Analysis/Blow up Menu." 3550 PRINT "Any other key returns to last menu."; 3560 I% = 0:IO% = 0: HPLOT 0,J 3580 FOR L = 1 TO 50 3590 I% = I% +5 3592 HPLOT I%,0 TO I%,5: HPLOT I%,153 TO I%,158 3600 X = AN *X *(1 -X) 3610 J = 145 -(X *145) 3620 IF J >0 AND J <150 THEN HPLOT IO%,JO TO I%,J 3625 IO% = I%:JO = J 3630 NEXT L 3640 HELP$ = "5": GOSUB 5200 3650 IF CM% = 13 OR CM% = 32 THEN 3510 3660 RETURN 4000 REM Title screen / Get Video Mode 4020 POKE 774,7: POKE 775,2: POKE 771,0 4025 POKE 773,255: CALL BOX,1,1,40,24 4030 POKE 768,31: POKE 769,4: CALL BOX,10,3,22,5 4040 POKE 770,11: POKE 772,3: PRINT "CHAOS EXPLORER": POKE 772,1 4050 PRINT : PRINT : PRINT 4060 POKE 770,2: PRINT "Logistic Difference Equation explorer": PRINT 4070 POKE 770,5: PRINT "Come take a voyage into a world" 4080 POKE 770,9: PRINT "of Chaos mathematics.": HCOLOR= 4 4090 POKE 768,168: POKE 770,12: PRINT "by Cregg Hardwick" 4100 FOR L = 25 TO 141 STEP 7 4110 X = COS(L/11) *20 +144:XO = COS(L/44) *45 +144 4120 HPLOT L,XO TO L,X: HPLOT 274 -L,XO TO 274 -L,X 4130 NEXT L 4190 FOR L = 1 TO 500: IF PEEK( -16384) >127 THEN 4200 4195 NEXT L 4200 POKE -16368,0: POKE 768,135: CALL BOX,8,17,26,5 4210 POKE 770,10: POKE 769,4: PRINT "Select Monocrome<1>" 4220 POKE 770,10: POKE 769,0: PRINT "or Color<2> graphics" 4225 POKE 770,15: PRINT "? for Help" 4230 POKE 768,104: POKE 770,20 4233 HELP$ = "6": GOSUB 5200 4240 IF CM% = 27 THEN GOSUB 9000 4250 IF C$ < >"1" AND C$ < >"2" THEN 4230 4260 MD% = VAL(C$) 4270 POKE 773,0 4280 RETURN 5000 REM Routine ClearText 5010 HCOLOR= 0 5020 FOR L = 159 TO 191 5030 HPLOT 0,L TO 279,L 5040 NEXT L 5050 POKE 768,160: POKE 770,0 5060 RETURN 5200 REM Handle Keypresses 5204 POKE -16368,0: GET C$:CM% = ASC(C$) 5205 IF C$ < >"?" AND C$ < >"/" AND CM% < >19 THEN 5490 5210 IF PEEK(MOVPG +18) >60 THEN 5490 5220 CALL MOVPG: CALL BOX,2,4,30,8:TA% = 6 5230 T3% = PEEK(768):T4% = PEEK(771):T5% = PEEK(772) 5235 T6% = PEEK(773):T7% = PEEK(774):T8% = PEEK(770) 5240 POKE 774,7: POKE 768,30: POKE 773,255: POKE 771,1: POKE 772,1 5250 IF C$ = "?" OR C$ = "/" THEN GOSUB 5500 5260 IF CM% < >19 THEN 5280 5262 POKE 770,3: PRINT "S O U N D :": PRINT : POKE 770,3 5265 IF BELL% THEN BELL% = 0: PRINT "Sound off": GOTO 5270 5266 BELL% = 1: PRINT "Sound on" 5270 GOSUB 5800 5280 REM <<< Add next handler here 5450 POKE 768,T3%: POKE 771,T4%: POKE 772,T5%: POKE 770,T8% 5460 POKE 773,T6%: POKE 774,T7%: CALL MOVPG +3 5490 RETURN 5500 REM Routine Help 5510 POKE 770,3: PRINT "H E L P :": PRINT 5520 POKE 770,4: PRINT "Searching . . ."; 5530 ONERR GOTO 5730 5560 PRINT D$"Open Explore.Hlp": PRINT D$"Read Explore.Hlp" 5570 INPUT HT$: IF HT$ = "~" THEN 5700 5580 IF LEFT$(HT$,1) < >"*" THEN 5570 5585 IF MID$ (HT$,2,1) < >HELP$ THEN 5570 5590 T9% = VAL( MID$ (HT$,3,2)):TA% = VAL( MID$ (HT$,5,2)) +5 5592 COM$ = "Position Explore.Hlp,R" + MID$ (HT$,7) 5593 PRINT D$;COM$: PRINT D$"Read Explore.Hlp" 5595 CALL BOX,3,6,T9%,TA%: POKE 768,48 5600 INPUT HT$ 5610 IF LEFT$(HT$,1) = "*" OR HT$ = "~" THEN GOSUB 5800: GOTO 5710 5615 POKE 770,4 5620 IF RIGHT$(HT$,1) < >"*" THEN PRINT HT$: GOTO 5600 5630 PRINT LEFT$(HT$, LEN(HT$) -1): PRINT 5640 POKE 770,3: PRINT "Press any key. . ." 5645 IF PEEK( -16384) < = 127 THEN 5645 5650 IF PEEK( -16384) = 155 THEN 5710 5660 POKE -16368,0 5690 GOTO 5595 5700 POKE 770,3: PRINT "No help available on this.": GOSUB 5800 5710 PRINT D$"Close Explore.Hlp" 5720 RETURN 5730 POKE 216,0: CALL FIX 5740 POKE 770,3: PRINT "Unable to read 'Explore.Hlp'." 5750 GOSUB 5800: GOTO 5710 5800 REM Routine Exit tab 5805 TA% = 36 +(TA% *8): POKE 768,TA%: POKE 770,3: PRINT " Press any key. . . " 5810 HCOLOR= 3: HPLOT 21,TA% +8 TO 145,TA% +8 5812 HCOLOR= 0: HPLOT 20,TA% +2 TO 20,TA% +8: HPLOT 146,TA% +8 TO 146,TA% +2 5815 HPLOT 19,TA% +2 TO 19,TA% +9 TO 147,TA% +9 TO 147,TA% +2 5820 IF PEEK( -16384) < = 127 THEN 5820 5830 POKE -16368,0 5840 RETURN 9000 REM Routine Exit program 9005 T3% = PEEK(768):T4% = PEEK(771):T5% = PEEK(772) 9006 T6% = PEEK(773):T7% = PEEK(774):T8% = PEEK(770) 9010 CALL MOVPG: CALL BOX,3,7,36,9: POKE 774,7 9020 POKE 768,60: POKE 773,255: POKE 771,1: POKE 772,1 9025 POKE 770,16: PRINT "E X I T ?": PRINT 9030 POKE 770,7: PRINT "Press <Y> to quit program." 9035 POKE 770,5: PRINT "Press Esc to return to program." 9040 POKE 770,4: PRINT "Press any other key to run again." 9050 GET EX$:CM% = ASC(EX$) 9060 IF CM% < >27 THEN 9070 9065 POKE 768,T3%: POKE 771,T4%: POKE 772,T5%: POKE 770,T8% 9066 POKE 773,T6%: POKE 774,T7%: CALL MOVPG +3 9067 RETURN 9070 IF EX$ = "Y" OR EX$ = "y" THEN PRINT D$"BYE" 9080 RUN 10000 REM | Okay to add new char to input string... 10001 GOSUB 5000 10010 PRINT "Please enter a filename or" 10020 PRINT "press Return to abort." 10030 GOSUB 12000: IF C$ = "" THEN 10500 10035 GOSUB 5000 10040 FILE$ = C$ +".Dat": ONERR GOTO 11400 10050 PRINT D$"OPEN "FILE$: PRINT D$"WRITE "FILE$ 10060 PRINT I%: PRINT R: PRINT RO: PRINT MG: PRINT IN: PRINT GS: PRINT GF 10070 PRINT D$"Close "FILE$ 10080 FILE$ = "BSAVE " +C$ +".Pic,A$2000,l$2000" 10090 PRINT D$;FILE$ 10500 RETURN 11000 REM Load file 11010 GOSUB 5000: PRINT "Please enter name of file to load." 11015 GOSUB 12000 11020 FILE$ = C$ +".Pic" 11025 ONERR GOTO 11500 11030 PRINT D$"BLOAD "FILE$ 11049 FILE$ = C$ +".Dat" 11050 PRINT D$"OPEN "FILE$: PRINT D$"READ "FILE$ 11060 INPUT I%,R,RO,MG,IN,GS,GF 11070 PRINT D$"Close "FILE$ 11080 RETURN 11400 POKE 216,0: CALL FIX: GOSUB 5000 11410 POKE 770,0: PRINT "Unable to write '"FILE$"'." 11420 GOTO 11515 11500 POKE 216,0: CALL FIX: GOSUB 5000 11510 POKE 770,0: PRINT "Unable to read '"FILE$"'." 11515 PRINT : PRINT " Press any key. . ." 11520 IF PEEK( -16384) < = 127 THEN 11520 11530 POKE -16368,0 11540 GOTO 1186 12000 REM | Get String... 12010 PRINT "Filename ? ";:C$ = " " 12020 GET VL$:CM% = ASC(VL$) 12030 IF LEN(C$) <2 OR (CM% < >8 AND CM% < >127) THEN 12070 12040 C$ = LEFT$(C$, LEN(C$) -1) 12050 POKE 770, PEEK(770) -1: POKE 769,0 12060 PRINT " ";: POKE 770, PEEK(770) -2 12070 IF CM% = 13 THEN 12110 12080 IF LEN(C$) >25 THEN 12020 12085 IF (CM% <65 OR CM% >122) AND CM% < >47 THEN 12020 12090 C$ = C$ +VL$: POKE 769,1: PRINT VL$; 12095 IF VL$ = "i" OR VL$ = "l" OR VL$ = "I" THEN POKE 770, PEEK(770) +1 12100 GOTO 12020 12110 C$ = MID$ (C$,1): RETURN